home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / comm / brc_asp1.zip / ZIPCOMDT.PAS < prev    next >
Pascal/Delphi Source File  |  1992-01-30  |  7KB  |  152 lines
  1. program ZipCommentDate; {add comments to ZIP files from a file list
  2.                           and change the date/time of the ZIP file to the
  3.                           latest date/time of any file within}
  4.  
  5. { This program was written by Bruce Clawson, Wauwatosa, WI  USA.
  6.   The unit 'ZIPDIR.PAS' was picked up from the Atkinson Home Computer BBS
  7.   some time ago.  As I can't find any docs for it I sincerely hope that
  8.   I am not violating anyone's rights by including it here.
  9.   My program (ZIPCOMDT.PAS) is released to the public domain.  You are
  10.   free to use/abuse/modify/distribute it as you wish but please leave
  11.   this comment area intact.  Direct comments to me on EXEC-PC.          }
  12.           { compiled with Borland's Turbo Pascal 6.0 }
  13.  
  14. {$M 16384,0,32768}   {needed because of 'exec' command}
  15. uses
  16.    dos, ZipDir; {I got the ZipDir unit from the Atkinson Home Computer BBS}
  17.                 {I hope I am not violating anyone by including it here}
  18.  
  19. const
  20.    NameFileName = '#comment.###';  {name of the temporary file  }
  21. { The ZIP file comment/description is written out to this file. }
  22. { PKZIP is called with the '-z' parameter to update the comment }
  23. { field and DOS redirection is used to have it read in the temp }
  24. { file in place of a keyboard entry.                            }
  25.  
  26. var
  27.    SrceFile : text;    {logfile containing ZIP file names and comments}
  28.    NameFile : text;    {temporary workfile}
  29.  
  30. function Exist (FileName : string): boolean;  {does a file exist?}
  31. var
  32.    DirInfo : SearchRec;   {defined in the DOS unit}
  33. begin
  34.    Exist := false;
  35.    FindFirst (FileName, Archive+ReadOnly, DirInfo);
  36.    if DosError = 0
  37.       then Exist := true;                    {yes, it exists}
  38. end;  {Function Exist}
  39.  
  40. procedure AskSrceName (var FileName : string);
  41. begin
  42.    writeln;
  43.    write  ('Enter Input Logfile Name: ');
  44.    readln (FileName);
  45. end;
  46.  
  47. procedure Comments (PkZip : PathStr);
  48. var
  49.    ZipFile      : text;     {the ZIP file itself}
  50.    ZipName      : string;   {name of ZIP file}
  51.    ZipDirItem   : string;   {ZIP directory item from 'ZIPDIR' unit}
  52.    SrceRec      : string;   {logfile record area}
  53.    Description  : string;   {Comment field from logfile}
  54.    CommandLine  : string;   {Command for DOS to execute}
  55.    ZfDaTi       : longint;  {file date/time in system format}
  56.    ZfDateTime   : DateTime; {file date/time structure (DOS unit)}
  57.    ZipDateTime  : string;   {used to find newest member file}
  58.    TmpDateTime  : string;   {used to find newest member file}
  59.    ZipDirStatus : integer;  {status returned by 'ZIPDIR' unit}
  60.    Sub          : integer;  {a counter}
  61. begin
  62.    readln (SrceFile, SrceRec);     {read a record from the logfile}
  63.    Sub := pos ('.ZIP', SrceRec);   {where does '.ZIP' occur in the record?}
  64.    if (Sub = 0) or (Sub > 9)       {if not at all or past column 9...}
  65.       then exit;                          {probably not a valid filename}
  66.    ZipName := copy (SrceRec,1,Sub+3);     {extract ZIP filename}
  67.    if not Exist (ZipName)                 {does it exist?}
  68.       then exit;                          {if no then exit}
  69.    if length (SrceRec) > 27               {extract comment}
  70.       then Description := copy (SrceRec,28,length (SrceRec)-27);
  71.    rewrite (NameFile);                    {open the file output}
  72.    writeln (NameFile,Description);        {write the comment to it}
  73.    close   (NameFile);                    {close the file}
  74.    {note: I could not call PKZIP directly because of the redirection
  75.           in the command line.  It works OK going through 'COMMAND.COM'.}
  76.    SwapVectors;   {good form for 'exec' command}
  77.    exec (GetEnv ('COMSPEC'), ' /C ' + PkZip + ' -z ' + ZipName
  78.                 + ' <' + NameFileName + ' >NUL');  {call PKZIP}
  79.    SwapVectors;   {good form for 'exec' command}
  80.    if (DosError <> 0) or (DosExitCode <> 0)   {if something screwed up}
  81.       then writeln ('DosError = ', DosError,
  82.                     'EXEC exit code = ', DosExitCode);
  83.    assign (ZipFile,ZipName);           {assign the ZIP file}
  84.    reset  (ZipFile);                   {open for input}
  85.    getftime (ZipFile,ZfDaTi);          {get its date/time}
  86.    unpacktime (ZfDaTi, ZfDateTime);    {convert to usable format}
  87.    ZipDateTime := '00000000000000';    {clear out}
  88.    ZipDirSetup (ZipName,ZipDirStatus); {do ZIP directory setup}
  89.    while ZipDirStatus = 0 do           {until 'eof'}
  90.          begin
  91.          ZipDirFetch (ZipDirItem,ZipDirStatus);  {get ZIP member file info}
  92.          TmpDateTime := copy (ZipDirItem,35,4)   {year}
  93.                       + copy (ZipDirItem,29,2)   {month}
  94.                       + copy (ZipDirItem,32,2)   {day}
  95.                       + copy (ZipDirItem,40,2)   {hour}
  96.                       + copy (ZipDirItem,43,2)   {minute}
  97.                       + copy (ZipDirItem,46,2);  {second}
  98.          if TmpDateTime > ZipDateTime            {which is newer?}
  99.             then ZipDateTime := TmpDateTime;
  100.          end;
  101.    with ZfDateTime do       {plug back into DOS.DateTime format}
  102.       begin
  103.       val (copy (ZipDateTime, 1,4),Year, Sub);
  104.       val (copy (ZipDateTime, 5,2),Month,Sub);
  105.       val (copy (ZipDateTime, 7,2),Day,  Sub);
  106.       val (copy (ZipDateTime, 9,2),Hour, Sub);
  107.       val (copy (ZipDateTime,11,2),Min,  Sub);
  108.       val (copy (ZipDateTime,13,2),Sec,  Sub);
  109.       end;
  110.    packtime (ZfDateTime,ZfDaTi);    {convert to system format}
  111.    setftime (ZipFile,ZfDaTi);       {update disk directory values}
  112.    close    (ZipFile);              {close the file}
  113.    writeln;
  114.    while length (ZipName) < 14 do
  115.       ZipName := ZipName + ' ';           {pad the name out to 14 characters}
  116.    write   (ZipName, '  ');
  117.    write   (copy (ZipDateTime,5,2), '-');
  118.    write   (copy (ZipDateTime,7,2), '-');
  119.    write   (copy (ZipDateTime,3,2), '  ');
  120.    writeln (Description);           {show on screen}
  121. end;                                {Comments}
  122.  
  123. {*********************************}
  124. {-----MAINLINE PROGRAM CODING-----}
  125. {*********************************}
  126. var
  127.    SrceName : string;   {name of logfile}
  128.    PkZip    : PathStr;  {full path name of PkZip program}
  129. begin                                  {MainProgram}
  130.    PkZip := fsearch ('PKZIP.EXE', GetEnv ('PATH'));
  131.    if PkZip = ''
  132.       then begin
  133.            writeln;
  134.            writeln ('Cannot find PKZIP.EXE!!! <program abort>');
  135.            halt (1);
  136.            end;
  137.    if (ParamStr (1) <> '')             {logfile name on command line?}
  138.       then SrceName := ParamStr (1)    {yes, use it}
  139.       else AskSrceName (SrceName);     {no, ask for one}
  140.    if not Exist (SrceName)             {if it can't be found}
  141.       then repeat AskSrceName (SrceName) {keep asking}
  142.            until Exist (SrceName);         {until we get one}
  143.    assign (SrceFile,SrceName);         {assign the logfile}
  144.    reset  (SrceFile);                  {open the logfile for input}
  145.    assign (NameFile,NameFileName);     {assign the temporary file}
  146.    while not eof (SrceFile)
  147.       do Comments (PkZip);
  148.    close (SrceFile);
  149.    if Exist (NameFileName)
  150.       then erase (NameFile);      {erase the temp file if it exists}
  151. end.                                   {MainProgram}
  152.